home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / wrnsr094 / code.bas < prev    next >
Encoding:
BASIC Source File  |  1995-05-09  |  4.6 KB  |  175 lines
  1. Sub change_chars (ByVal from$, ByVal new$, dest$)
  2.    pos = InStr(dest$, from$)
  3.    While pos <> 0
  4.       Mid$(dest$, pos) = new$
  5.       pos = InStr(dest$, from$)
  6.    Wend
  7. End Sub
  8.  
  9. Sub extract_param (ByVal filename$, ByVal param$, dest$)
  10.    dest$ = ""
  11.    fileno = fopen(filename$, "r")
  12.    While Not EOF(fileno) And Len(dest$) = 0
  13.       Input #fileno, text_line$
  14.       If Left$(text_line$, Len(param$)) = param$ Then
  15.      dest$ = Mid$(text_line$, InStr(text_line$, ":") + 1)
  16.      While Left$(dest$, 1) = " "
  17.         dest$ = Mid$(dest$, 2)
  18.      Wend
  19.       End If
  20.    Wend
  21.    Close #fileno
  22. End Sub
  23.  
  24. Function fopen (ByVal fname$, ByVal mode$) As Integer
  25.    fileno% = FreeFile
  26.    On Error Resume Next
  27.    Select Case mode$
  28.    Case "r":  Open fname$ For Input As #fileno%
  29.    Case "rb": Open fname$ For Binary Access Read As #fileno%
  30.    Case "w":  Open fname$ For Output As #fileno%
  31.    Case "a":  Open fname$ For Append As #fileno%
  32.    Case Else
  33.       MsgBox "Invalid fopen() mode: " + mode$
  34.       Stop
  35.    End Select
  36.    If Err = 0 Then
  37.       fopen = fileno%
  38.    Else
  39.       fopen = 0
  40.       MsgBox fname$ + ": " + Error$, 16, "File Open Error"
  41.       End
  42.    End If
  43. End Function
  44.  
  45. Function get_filename (ByVal direct As String) As String
  46.    file_select.visible = True
  47.    file_select.enabled = True
  48.    file_select.SetFocus
  49.    file_select.sel_dir.path = direct
  50.    edit.enabled = false
  51.    While file_select.visible
  52.       dummy% = DoEvents()
  53.    Wend
  54.    edit.enabled = true
  55.    edit.SetFocus
  56.    
  57.    get_filename$ = file_select.sel_filename.Text
  58. End Function
  59.  
  60. Sub get_header (dest$, subject$, sig%, ByVal mail)
  61.    If subject$ <> "" Then
  62.       header_form.subject.Text = "Re: " + subject$
  63.    Else
  64.       header_form.subject.Text = ""
  65.    End If
  66.    header_form.sig_check.value = sig%
  67.    header_form.dest.Text = dest$
  68.    If mail Then
  69.       header_form.dest_caption.Text = "To:"
  70.    Else
  71.       header_form.dest_caption.Text = "Newsgroups:"
  72.    End If
  73.  
  74.    header_form.visible = True
  75.    header_form.enabled = True
  76.    header_form.SetFocus
  77.    edit.enabled = false
  78.    While header_form.visible
  79.       dummy% = DoEvents()
  80.    Wend
  81.    edit.enabled = true
  82.    edit.SetFocus
  83.    dest$ = header_form.dest.Text
  84.    subject$ = header_form.subject.Text
  85.    sig% = header_form.sig_check.value
  86. End Sub
  87.  
  88. Function get_mail (ByVal ind%) As String
  89.    dest$ = ""
  90.    fileno = fopen(mail_file$ + ".i", "rb")
  91.    i% = -1
  92.    dummy$ = String$(28, 0)
  93.    While i% < ind% And Not EOF(fileno)
  94.       Get #fileno, , offset&
  95.       Get #fileno, , length&
  96.       Get #fileno, , dummy$
  97.       i% = i% + 1
  98.    Wend
  99.    Close #fileno
  100.    If i% = ind% Then
  101.       fileno = fopen(mail_file$ + ".f", "rb")
  102.       Seek #fileno, offset& + 1
  103.       dest$ = String$(length&, 0)
  104.       Get #fileno, , dest$
  105.       Close #fileno
  106.    End If
  107.    get_mail = dest$
  108. End Function
  109.  
  110. Function load_file (ByVal filename$) As String
  111.    fileno% = fopen(filename$, "rb")
  112.    If LOF(fileno%) > 16000 Then
  113.       dest$ = Input$(16000, #fileno%)
  114.       pos = InStr(dest$, new_line + new_line)
  115.       load_file = Left$(dest$, pos + 3) + "**** Truncated ****" + new_line + new_line + Mid$(dest$, pos + 4)
  116.       Beep
  117.    Else
  118.       load_file = Input$(LOF(fileno%), #fileno%)
  119.    End If
  120.    Close #fileno%
  121. End Function
  122.  
  123. Sub make_dir (ByVal source$, dest$)
  124.    dest$ = ""
  125.    pos = InStr(source$, ".")
  126.    While pos <> 0
  127.       If pos <= 8 Then
  128.      dest$ = dest$ + Left$(source$, pos - 1) + "\"
  129.       Else
  130.      dest$ = dest$ + Left$(source$, 8) + "\"
  131.       End If
  132.       source$ = Mid$(source$, pos + 1)
  133.       pos = InStr(source$, ".")
  134.    Wend
  135.    dest$ = news_dir$ + dest$ + Left$(source$, 8) + "\"
  136. End Sub
  137.  
  138. Function read_ini (ByVal key$) As String
  139.    result$ = Space$(128)
  140.  
  141.    valid% = getprivateprofilestring("WRN", key$, "", result$, Len(result$), ".\WRN.INI")
  142.    If valid% = 0 Then
  143.       MsgBox key$ + " .INI parameter missing", 16, "Error in .INI file"
  144.       End
  145.    End If
  146.    read_ini = Left$(result$, valid%)
  147. End Function
  148.  
  149. Sub word_wrap (Text As String, ByVal length As Integer)
  150.    startpos = 0
  151.    pos = InStr(startpos + 1, Text, Chr$(13))
  152.    While pos <> 0
  153.       linelen = pos - startpos
  154.       If linelen > length Then
  155.      pos = startpos + length
  156.      Do
  157.         If InStr(" .,:;-?!", Mid$(Text, pos, 1)) <> 0 Then
  158.            Exit Do
  159.         End If
  160.         pos = pos - 1
  161.      Loop While pos > startpos
  162.       End If
  163.       If startpos = pos Then
  164.      pos = startpos + length
  165.       End If
  166.       If Asc(Mid$(Text, pos)) <> 13 Then
  167.      Text = Left$(Text, pos) + new_line + Mid$(Text, pos + 1)
  168.       End If
  169.       startpos = pos + 3
  170.       pos = InStr(startpos + 1, Text, Chr$(13))
  171.    Wend
  172.  
  173. End Sub
  174.  
  175.